Whiteline: Alpha/Whiteline Alpha.iso/progtool/modula2/hk_lib/def_mod/longsets.mod

Modula Implementation | 1994-09-22 | 19.5 KB | 582 lines

IMPLEMENTATION MODULE  LongSets;

(*****************************************************************************)
(* Die Prozeduren werden durch die in MODULA enthaltenen Mengenoperationen,  *)
(* angewendet auf jeweils einzelne BITSETs, implementiert.                   *)
(*                                                                           *)
(* Um ein bestimmtes Element einer Menge zu selektieren, muessen zwei Dinge  *)
(* getan werden:                                                             *)
(*                                                                           *)
(*  - Die zum Element gehoerende BITSET muss durch                           *)
(*                                                                           *)
(*           menge[ VAL( CARDINAL, elem ) DIV ElementsInBITSET ]             *)
(*                                                                           *)
(*    ausgewaehlt werden.                                                    *)
(*                                                                           *)
(*  - Innerhalb dieser BITSET muss das gewuenschte Element durch             *)
(*                                                                           *)
(*                  VAL( CARDINAL, elem ) MOD ElementsInBITSET               *)
(*                                                                           *)
(*    ausgewaehlt werden.                                                    *)
(*                                                                           *)
(* Da der Typ "Set" aus einzelnen BITSETs zusammengesetzt ist, sind evtl.    *)
(* zusaetzliche Bits vorhanden, wenn "ElementsInSet" kein Vielfaches von 16  *)
(* ist. Um unerwuenschten Ergebnissen vorzubeugen, falls Bits gesetzt sind,  *)
(* die nicht zur Menge gehoeren, werden diese Bits bei einigen Prozeduren ge-*)
(* loescht, bzw. die Prozeduren erst gar nicht ausgefuehrt.                  *)
(*___________________________________________________________________________*)
(*                                                                           *)
(* 04-Dez-89 , hk                                                            *)
(*        Beginn                                                             *)
(* 23-Dez-89 , hk                                                            *)
(*        erste Version                                                      *)
(* 05-Jan-90 , hk                                                            *)
(*        kleinen Fehler in "IsProperSubset" beseitigt;                      *)
(*        "WriteSet", "AllElements", "IsFullSet", "IsSuperset",              *)
(*        "IsProperSuperset", "Equal" neu                                    *)
(* 10-Jan-90 , hk                                                            *)
(*        Statt ORD( elem ) wird jetzt VAL( CARDINAL, elem ) verwendet, damit*)
(*        fuer DIV und MOD einfache Bitfunktionen verwendet werden, ORD lie- *)
(*        fert leider ein Ergebnis vom Typ INTEGER, sodass fuer DIV und MOD  *)
(*        immer Divisionsoperationen verwendet werden ( weil das Teilen ne-  *)
(*        gativer Zahlen durch eine Zweierpotenz NICHT durch einen arithme-  *)
(*        tischen Rechtsshift erledigt  werden kann ).                       *)
(*        Neue Prozeduren "IncludeRange", "ExcludeRange"                     *)
(*****************************************************************************)

FROM  SYSTEM   IMPORT  (* PROC *) VAL, INLINE, SHIFT;
FROM  Terminal IMPORT  (* PROC *) Write, WriteLn;

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)

VAR  ElemMask : BITSET; (* siehe Modulinit. *)

(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)


  PROCEDURE  NoElements ((* -- /AUS *) VAR  menge : Set );
(*T*)
     VAR  Index : CARDINAL;

     BEGIN
       FOR Index := 0 TO NoOfBITSETs - 1 DO
          menge[ Index ] := {};
       END
     END  NoElements;

(*---------------------------------------------------------------------------*)

  PROCEDURE  AllElements ((* -- /AUS *) VAR  menge : Set );
(*T*)
     VAR  Index : CARDINAL;

     BEGIN
       FOR Index := 0 TO NoOfBITSETs - 1 DO
          menge[ Index ] := { 0..15 };
       END;

       (* Die evtl. zusaetzlichen Bits wieder
        * loeschen.
        *)
       menge[ NoOfBITSETs - 1 ] := menge[ NoOfBITSETs - 1 ] * ElemMask;

     END  AllElements;

(*---------------------------------------------------------------------------*)

  PROCEDURE  IsEmptySet ((* EIN/ -- *) menge : Set ): BOOLEAN;
(*T*)
     VAR  Index    : CARDINAL;
          Zwischen : BITSET;

     BEGIN
       Index := 0;

       Zwischen := menge[ NoOfBITSETs - 1 ] * ElemMask;
       menge[ NoOfBITSETs - 1 ] := BITSET{0..15};

       (* Dadurch, das in <menge> auf jeden Fall eine nichtleere BITSET-
        * Menge auftritt, kann die Abfrage des Index in der WHILE-
        * Bedingung entfallen.
        *)
       WHILE   menge[ Index ] = {}   DO
          INC( Index );
       END;

       IF  Index = NoOfBITSETs - 1  THEN
          (* Wenn <menge> bis hierhin leer ist, entscheidet
           * das letzte BITSET von <menge>, ob sie wirklich
           * leer ist
           *)
          RETURN( Zwischen = {} );
       ELSE
          (* sonst ist schon vorher eine BITSET-Teilmenge
           * nicht leer gewesen
           *)
          RETURN( FALSE );
       END;

     END  IsEmptySet;

(*---------------------------------------------------------------------------*)

  PROCEDURE  IsFullSet ((* EIN/ -- *) menge : Set ): BOOLEAN;
(*T*)
     VAR  Index    : CARDINAL;
          Zwischen : BITSET;

     BEGIN
       Index := 0;

       Zwischen := menge[ NoOfBITSETs - 1 ] + ( ElemMask / BITSET{ 0..15 } );

       (* Die hinteren ueberfluessigen Bits werden gesetzt,
        * damit auf eine volle BITSET verglichen werden kann
        *)
       menge[ NoOfBITSETs - 1 ] := BITSET{ };

       (* Dadurch, das in <menge> auf jeden Fall eine leere BITSET-
        * Menge auftritt, kann die Abfrage des Index in der WHILE-
        * Bedingung entfallen.
        *)
       WHILE   menge[ Index ] = { 0..15 }   DO
          INC( Index );
       END;

       IF  Index = NoOfBITSETs - 1  THEN
          (* Wenn <menge> bis hierhin voll ist, entscheidet
           * das letzte BITSET von <menge>, ob sie wirklich
           * voll ist
           *)
          RETURN( Zwischen = { 0..15 } );
       ELSE
          (* sonst ist schon vorher eine BITSET-Teilmenge
           * nicht voll gewesen
           *)
          RETURN( FALSE );
       END;

     END  IsFullSet;

(*---------------------------------------------------------------------------*)

  PROCEDURE Complement ((* EIN/ -- *)     menge : Set;
                        (* -- /AUS *) VAR compl : Set  );
(*T*)
     VAR  Index : CARDINAL;

     BEGIN
       FOR  Index := 0  TO  NoOfBITSETs - 1  DO
          compl[ Index ] := menge[ Index ] / BITSET{0..15};

          (* /menge XOR 0FFFFH/ ist das gleiche wie /NOT menge/ *)
       END;

       (* Die ueberfluessigen Bits muessen noch
        * geloescht werden.
        *)
       compl[ NoOfBITSETs - 1 ] := compl[ NoOfBITSETs - 1 ] * ElemMask;

     END  Complement;

(*---------------------------------------------------------------------------*)

  PROCEDURE  Card ((* EIN/ -- *) menge : Set ): CARDINAL;
(*T*)
     VAR  Elemente,
          Index,
          Bit     : CARDINAL;

     BEGIN
       (* Sicherheitshalber ueberfluessige Bits loeschen *)
       menge[ NoOfBITSETs - 1 ] := menge[ NoOfBITSETs - 1 ] * ElemMask;

       Elemente := 0;

       FOR  Index := 0  TO  NoOfBITSETs - 1  DO
          FOR  Bit := 0  TO  ElementsInBITSET - 1  DO
             IF  Bit  IN  menge[ Index ]  THEN
                INC( Elemente );
             END; (* IF Bit *)
          END; (* FOR Bit *)
       END; (* FOR Index *)

       RETURN( Elemente );

     END  Card;

(*---------------------------------------------------------------------------*)

  PROCEDURE  IsElement ((* EIN/ -- *) elem  : SetElement;
                        (* EIN/ -- *) menge : Set        ): BOOLEAN;
(*T*)
     BEGIN
       IF  elem <= MAX( SetElement )  THEN
          (* Element nur testen, falls im gueltigen Bereich *)

          RETURN(           VAL( CARDINAL, elem ) MOD ElementsInBITSET
                  IN menge[ VAL( CARDINAL, elem ) DIV ElementsInBITSET ] );
       ELSE
          RETURN( FALSE );
       END;
     END  IsElement;

(*---------------------------------------------------------------------------*)

  PROCEDURE  Include ((* EIN/ -- *)     elem  : SetElement;
                      (* EIN/AUS *) VAR menge : Set        );
(*T*)
     BEGIN
       IF  elem <= MAX( SetElement )  THEN
          (* Element nur einfuegen, falls im gueltigen Bereich *)

          INCL( menge[ VAL( CARDINAL, elem ) DIV ElementsInBITSET ],
                       VAL( CARDINAL, elem ) MOD ElementsInBITSET   );
       END;
     END  Include;

(*---------------------------------------------------------------------------*)

  PROCEDURE  Exclude ((* EIN/ -- *)     elem  : SetElement;
                      (* EIN/AUS *) VAR menge : Set        );
(*T*)
     BEGIN
       IF  elem <= MAX( SetElement )  THEN

          EXCL( menge[ VAL( CARDINAL, elem ) DIV ElementsInBITSET ],
                       VAL( CARDINAL, elem ) MOD ElementsInBITSET   );
       END;
     END  Exclude;

(*---------------------------------------------------------------------------*)

  PROCEDURE IncludeRange ((* EIN/ -- *)     von,
                          (* EIN/ -- *)     bis   : SetElement;
                          (* EIN/AUS *) VAR menge : Set        );
(*T*)
     VAR  vonIdx,
          bisIdx   : INTEGER;
          vonMaske,
          bisMaske : BITSET;

     BEGIN
       IF  bis > MAX( SetElement )  THEN
         bis := MAX( SetElement );
       END;

       IF  von <= bis  THEN

          (* Erst mal die erste und die letzte BITSET auswaehlen
           *)

          vonIdx   := VAL( CARDINAL, von )  DIV  ElementsInBITSET;
          bisIdx   := VAL( CARDINAL, bis )  DIV  ElementsInBITSET;

          (* Die Masken fuer die gueltigen Bits in der
           * ersten und der letzten BITSET berechnen
           *)

          vonMaske := SHIFT( { 0..15 },
                             VAL( CARDINAL, von ) MOD ElementsInBITSET );
          bisMaske := SHIFT( { 0..15 },
                             VAL( CARDINAL, bis ) MOD ElementsInBITSET - 15 );


          IF  vonIdx = bisIdx  THEN

             (* Der Bereich liegt innerhalb einer einzigen
              * BITSET; die Make ist daher die Schnittmenge
              * der beiden Einzelmasken
              *)
             menge[ vonIdx ] := menge[ vonIdx ] + ( vonMaske * bisMaske );
          ELSE

             (* Die Bits in der ersten und letzten betroffenen
              * BITSET werden entsprechend den Masken gesetzt
              * und alle dazwischenliegenden BITSETs vollstaendig
              * aufgefuellt; besteht der Bereich nur aus zwei
              * BITSETs, wird die Schleife nicht durchlaufen.
              *)

             menge[ vonIdx ] := menge[ vonIdx ] + vonMaske;
             menge[ bisIdx ] := menge[ bisIdx ] + bisMaske;

             FOR  vonIdx := vonIdx + 1  TO  bisIdx - 1  DO

                menge[ vonIdx ] := BITSET{ 0..15 };
             END; (* FOR *)

          END; (* IF vonIdx *)
       END; (* IF von <= *)
     END  IncludeRange;

(*---------------------------------------------------------------------------*)

  PROCEDURE ExcludeRange ((* EIN/ -- *)     von,
                          (* EIN/ -- *)     bis   : SetElement;
                          (* EIN/AUS *) VAR menge : Set        );
(*T*) (* wie "IncludeRange *)
     VAR  vonIdx,
          bisIdx   : INTEGER;
          vonMaske,
          bisMaske : BITSET;

     BEGIN
       IF  bis > MAX( SetElement )  THEN
         bis := MAX( SetElement );
       END;

       IF  von <= bis  THEN

          vonIdx   := VAL( CARDINAL, von )  DIV  ElementsInBITSET;
          bisIdx   := VAL( CARDINAL, bis )  DIV  ElementsInBITSET;

          vonMaske := SHIFT( { 0..15 },
                             VAL( CARDINAL, von ) MOD ElementsInBITSET - 16 );
          bisMaske := SHIFT( { 0..15 },
                             VAL( CARDINAL, bis ) MOD ElementsInBITSET + 1 );


          IF  vonIdx = bisIdx  THEN

             menge[ vonIdx ] := menge[ vonIdx ] * ( vonMaske + bisMaske );
          ELSE
             menge[ vonIdx ] := menge[ vonIdx ] * vonMaske;
             menge[ bisIdx ] := menge[ bisIdx ] * bisMaske;

             FOR  vonIdx := vonIdx + 1  TO  bisIdx - 1  DO

                menge[ vonIdx ] := BITSET{ };
             END; (* FOR *)
          END; (* IF vonIdx *)
       END; (* IF von <= *)
     END  ExcludeRange;

(*---------------------------------------------------------------------------*)

  PROCEDURE  Union ((* EIN/ -- *)     menge1,
                    (* EIN/ -- *)     menge2 : Set;
                    (* -- /AUS *) VAR verein : Set  );
(*T*)
     VAR  Index : CARDINAL;

     BEGIN
       FOR  Index := 0  TO  NoOfBITSETs - 1  DO
          verein[ Index ] := menge1[ Index ] + menge2[ Index ];
       END;
     END Union;

(*---------------------------------------------------------------------------*)

  PROCEDURE  Intersection ((* EIN/ -- *)     menge1,
                           (* EIN/ -- *)     menge2  : Set;
                           (* -- /AUS *) VAR schnitt : Set  );
(*T*)
     VAR  Index : CARDINAL;

     BEGIN
       FOR  Index := 0  TO  NoOfBITSETs - 1  DO
          schnitt[ Index ] := menge1[ Index ] * menge2[ Index ];
       END;
     END Intersection;

(*---------------------------------------------------------------------------*)

  PROCEDURE  Difference ((* EIN/ -- *)     menge1,
                         (* EIN/ -- *)     menge2 : Set;
                         (* -- /AUS *) VAR diff   : Set  );
(*T*)
     VAR  Index : CARDINAL;

     BEGIN
       FOR  Index := 0  TO  NoOfBITSETs - 1  DO
          diff[ Index ] := menge1[ Index ] - menge2[ Index ];
       END;
     END Difference;

(*---------------------------------------------------------------------------*)

  PROCEDURE  SymmetricDiff ((* EIN/ -- *)     menge1,
                            (* EIN/ -- *)     menge2  : Set;
                            (* -- /AUS *) VAR symdiff : Set  );
(*T*)
     VAR  Index : CARDINAL;

     BEGIN
       FOR  Index := 0  TO  NoOfBITSETs - 1  DO
          symdiff[ Index ] := menge1[ Index ] / menge2[ Index ];
       END;
     END SymmetricDiff;

(*---------------------------------------------------------------------------*)

  PROCEDURE  Equal ((* EIN/ -- *) menge1,
                    (* EIN/ -- *) menge2 : Set ): BOOLEAN;
(*T*)
     VAR  Index : CARDINAL;

     BEGIN
       Index := 0;

       WHILE  ( Index < NoOfBITSETs                )  &
              ( menge1[ Index ] = menge2[ Index ] )
       DO
          INC( Index );
       END;

       RETURN( Index = NoOfBITSETs );

     END  Equal;

(*---------------------------------------------------------------------------*)

  PROCEDURE  IsSubset ((* EIN/ -- *) menge1,
                       (* EIN/ -- *) menge2 : Set ): BOOLEAN;
(*T*)
     VAR  Index : CARDINAL;

     BEGIN
       Index := 0;

       WHILE  ( Index < NoOfBITSETs                )  &
              ( menge1[ Index ] <= menge2[ Index ] )
       DO
          (* Nach der ersten BITSET von <menge1> abbrechen,
           * die keine Untermenge der BITSET von <menge2> ist
           *)
          INC( Index );
       END;

       RETURN( Index = NoOfBITSETs );

     END  IsSubset;

(*---------------------------------------------------------------------------*)

  PROCEDURE  IsProperSubset ((* EIN/ -- *) menge1,
                             (* EIN/ -- *) menge2 : Set ): BOOLEAN;
(*T*)
    VAR  Index    : CARDINAL;
         Ungleich : BOOLEAN;

    BEGIN
       Index := 0;
       Ungleich := FALSE;

       WHILE  ( Index < NoOfBITSETs                )  &
              ( menge1[ Index ] <= menge2[ Index ] )
       DO
          (* Es reicht, wenn nur eine einzige BITSET
           * unterschiedlich ist.
           *)
          Ungleich := Ungleich OR ( menge1[ Index ] #  menge2[ Index ] );
          INC( Index );
       END;

       RETURN(( Index = NoOfBITSETs ) & Ungleich );

  END  IsProperSubset;

(*---------------------------------------------------------------------------*)

  PROCEDURE  IsSuperset ((* EIN/ -- *) menge1,
                         (* EIN/ -- *) menge2 : Set ): BOOLEAN;
(*T*)
     VAR  Index : CARDINAL;

     BEGIN
       Index := 0;

       WHILE  ( Index < NoOfBITSETs                )  &
              ( menge1[ Index ] >= menge2[ Index ] )
       DO
          INC( Index );
       END;

       RETURN( Index = NoOfBITSETs );

     END  IsSuperset;

(*---------------------------------------------------------------------------*)

  PROCEDURE  IsProperSuperset ((* EIN/ -- *) menge1,
                               (* EIN/ -- *) menge2 : Set ): BOOLEAN;
(*T*)
    VAR  Index    : CARDINAL;
         Ungleich : BOOLEAN;

    BEGIN
       Index := 0;
       Ungleich := FALSE;

       WHILE  ( Index < NoOfBITSETs                )  &
              ( menge1[ Index ] >= menge2[ Index ] )
       DO
          (* Es reicht, wenn nur eine einzige BITSET
           * unterschiedlich ist.
           *)
          Ungleich := Ungleich OR ( menge1[ Index ] #  menge2[ Index ] );
          INC( Index );
       END;

       RETURN(( Index = NoOfBITSETs ) & Ungleich );

  END  IsProperSuperset;

(*---------------------------------------------------------------------------*)

  PROCEDURE  WriteSet ((* EIN/ -- *) menge : Set);
(*T*)
     VAR  Bitset : INTEGER;  (* Falls NoOfBITSETs = 1 *)
          Bit    : CARDINAL;

     BEGIN
       FOR  Bitset := 0  TO  NoOfBITSETs - 2  DO
          FOR  Bit := 0  TO  15  DO
             IF  Bit  IN  menge[ Bitset ]  THEN
                Write('1');
             ELSE
                Write('0');
             END;
          END;
          Write('|');

          (* Pro Zeile vier BITSETs ausgeben
           *)
          IF  ( Bitset + 1 ) MOD 4 = 0  THEN  WriteLn; END;
       END;

       (* Letzte BITSET wegen der evtl. zusaetzl.
        * Bits gesondert behandeln
        *)
       FOR  Bit := 0  TO  LastElements - 1  DO
          IF  Bit  IN  menge[ Bitset ]  THEN
             Write('1');
          ELSE
             Write('0');
          END;
       END;
       Write('|');

     END  WriteSet;

(*---------------------------------------------------------------------------*)

BEGIN (* Sets-Initialisierung *)

  (* Mit dieser Maske werden die gueltigen Bits der letzten
   * BITSET maskiert.
   * Das Wort mit dem Wert 0FFFFH - also alle Bits gesetzt -
   * wird um soviele Bits nach links geschoben wie gueltige
   * Bits in der letzten BITSET sind. Dann werden alle Bits
   * invertiert, d.h. dort wo gueltige Bits stehen sollen
   * ( von rechts betrachtet ), sind die Bits der Maske
   * gesetzt, alle weiteren Bits sind geloescht, sodass
   * bei einer UND-Verknuepfung ( durch den Vereinigungs-
   * operator '*' ) alle ungueltigen Bits geloescht werden.
   *)

  ElemMask := SHIFT( BITSET{ 0..15 }, LastElements ) / BITSET{ 0..15 };

END  LongSets.